home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / INOUTFIL.I < prev    next >
Encoding:
Modula Implementation  |  1991-07-21  |  13.6 KB  |  607 lines
  1. IMPLEMENTATION MODULE InOutFile; (* V#030 *)
  2. (*$Y+,R-,S-,M-*)
  3.  
  4. (*
  5.   27.6.88  TT  Einige $L- eingeführt.
  6.   17.9.88  TT  ReadNum/ReadLNum korrigiert - auch Korrektur in InOut!
  7.   21.7.91  TT  ReadReal ruft nun korrekterweise RealLReal statt ReadReal
  8.                aus NumberIO auf.
  9. *)
  10.  
  11. FROM SYSTEM IMPORT ASSEMBLER, WORD, LONGWORD, ADR, ADDRESS;
  12.  
  13. FROM FileNames IMPORT SplitPath, SplitName;
  14.  
  15. FROM Strings IMPORT Append, Length, Empty, MaxChars;
  16.  
  17. FROM InOutBase IMPORT consIn, consOut, done, eop, level, inLev, outLev, termCh;
  18.  
  19. IMPORT InOutBase;
  20.  
  21. FROM Files IMPORT File, Access, ReplaceMode;
  22.  
  23. IMPORT Files, Text, NumberIO;
  24.  
  25. (* Für folg. Import: *)
  26. FROM FileBase IMPORT Unit, UDataProc, UCloseProc, UFlushProc, UWStrProc,
  27.         URStrProc, UGChrProc;
  28.  
  29. (*$I FileDesc.Icl *)
  30.  
  31.  
  32. CONST   EOL = 15C;  (* wie in InOut ! *)
  33.  
  34. VAR     input, output: File;
  35.         ok: BOOLEAN;
  36.         goxy:ARRAY [0..3] OF CHAR;
  37.  
  38.  
  39. FORWARD initDriver;
  40.  
  41.  
  42. PROCEDURE ctrlIn;
  43.   (*$L-*)
  44.   BEGIN
  45.     IF ~consOut THEN
  46.       IF done THEN
  47.         IF consIn THEN InOutBase.CloseWdw END
  48.       ELSE
  49.         IF ~consIn THEN InOutBase.OpenWdw (0,0) END
  50.       END
  51.     END;
  52.     consIn:= ~done
  53.   END ctrlIn;
  54.   (*$L=*)
  55.  
  56. PROCEDURE ctrlOut;
  57.   (*$L-*)
  58.   BEGIN
  59.     IF ~consIn THEN
  60.       IF done THEN
  61.         IF consOut THEN InOutBase.CloseWdw END
  62.       ELSE
  63.         IF ~consOut THEN InOutBase.OpenWdw (0,0) END
  64.       END
  65.     END;
  66.     consOut:= ~done
  67.   END ctrlOut;
  68.   (*$L=*)
  69.  
  70. PROCEDURE clsIn;
  71.   (*$L-*)
  72.   BEGIN
  73.     IF ~consIn THEN Files.Close (input) END
  74.   END clsIn;
  75.   (*$L=*)
  76.  
  77. PROCEDURE clsOut;
  78.   (*$L-*)
  79.   BEGIN
  80.     IF ~consOut THEN Files.Close (output) END
  81.   END clsOut;
  82.   (*$L=*)
  83.  
  84. PROCEDURE doneIn;
  85.   (*$L-*)
  86.   BEGIN
  87.     done:= Files.State (input) >= 0;
  88.   END doneIn;
  89.   (*$L=*)
  90.  
  91. PROCEDURE doneOut;
  92.   (*$L-*)
  93.   BEGIN
  94.     done:= Files.State (output) >= 0;
  95.   END doneOut;
  96.   (*$L=*)
  97.  
  98.  
  99. PROCEDURE redirectInput (REF fileName: ARRAY OF CHAR);
  100.   BEGIN
  101.     initDriver;
  102.     clsIn;
  103.     inLev:= level;
  104.     Files.Open (input,fileName,readSeqTxt);
  105.     doneIn;
  106.     ctrlIn;
  107.   END redirectInput;
  108.  
  109. PROCEDURE redirectOutput (REF fileName: ARRAY OF CHAR; append: BOOLEAN);
  110.   VAR acc:Access;
  111.   BEGIN
  112.     initDriver;
  113.     clsOut;
  114.     IF append THEN acc:=appendSeqTxt ELSE acc:=writeSeqTxt END;
  115.     outLev:= level;
  116.     Files.Create (output,fileName,acc,replaceOld);
  117.     doneOut;
  118.     ctrlOut;
  119.   END redirectOutput;
  120.  
  121.  
  122. PROCEDURE apndExt ( REF def: ARRAY OF CHAR; VAR s: ARRAY OF CHAR );
  123.   VAR s1: ARRAY [0..79] OF CHAR;
  124.       s2: ARRAY [0..11] OF CHAR;
  125.   BEGIN
  126.     SplitPath (s,s1,s2);
  127.     SplitName (s2,s1,s2);
  128.     IF Empty (s2) & ( s[Length(s)-1] # '.' ) THEN
  129.       IF def[0]#'.' THEN
  130.         Append ('.',s,ok)
  131.       END;
  132.       Append (def,s,ok)
  133.     END
  134.   END apndExt;
  135.  
  136. PROCEDURE openInput ( REF defExt: ARRAY OF CHAR );
  137.   VAR name: ARRAY [0..79] OF CHAR; retry: BOOLEAN;
  138.   BEGIN
  139.     initDriver;
  140.     clsIn;
  141.     REPEAT
  142.       InOutBase.GetInput (name);
  143.       IF Empty (name) THEN
  144.         done:= FALSE;
  145.         retry:= FALSE
  146.       ELSE
  147.         apndExt (defExt,name);
  148.         inLev:= level;
  149.         Files.Open (input,name,readSeqTxt);
  150.         doneIn;
  151.         IF ~done THEN
  152.           Files.GetStateMsg (Files.State (input), name);
  153.           InOutBase.OpenError (name, retry)
  154.         END
  155.       END
  156.     UNTIL done OR ~retry;
  157.     ctrlIn;
  158.   END openInput;
  159.  
  160. PROCEDURE openOutput ( REF defExt: ARRAY OF CHAR );
  161.   VAR name: ARRAY [0..79] OF CHAR;
  162.   VAR retry, append: BOOLEAN;
  163.         acc:Access;
  164.   BEGIN
  165.     initDriver;
  166.     clsOut;
  167.     REPEAT
  168.       InOutBase.GetOutput (name,append);
  169.       IF Empty (name) THEN
  170.         done:= FALSE;
  171.         retry:= FALSE
  172.       ELSE
  173.         apndExt (defExt,name);
  174.         IF append THEN acc:=appendSeqTxt ELSE acc:=writeSeqTxt END;
  175.         outLev:= level;
  176.         Files.Create (output,name,acc,replaceOld);
  177.         doneOut;
  178.         IF ~done THEN
  179.           Files.GetStateMsg (Files.State (output), name);
  180.           InOutBase.OpenError (name, retry)
  181.         END
  182.       END
  183.     UNTIL done OR ~retry;
  184.     ctrlOut;
  185.   END openOutput;
  186.  
  187. PROCEDURE clsInOut;
  188.   (*$L-*)
  189.   BEGIN
  190.     IF ~consOut & ~consIn & ~eop THEN InOutBase.OpenWdw (0,0) END
  191.   END clsInOut;
  192.   (*$L=*)
  193.  
  194. PROCEDURE CloseInput;
  195.   (*$L-*)
  196.   BEGIN
  197.     Files.ResetState (input);
  198.     Files.Close (input);
  199.     clsInOut;
  200.     consIn:=TRUE;
  201.   END CloseInput;
  202.   (*$L=*)
  203.  
  204. PROCEDURE CloseOutput;
  205.   (*$L-*)
  206.   BEGIN
  207.     Files.ResetState (output);
  208.     Files.Close (output);
  209.     clsInOut;
  210.     consOut:=TRUE;
  211.   END CloseOutput;
  212.   (*$L=*)
  213.  
  214.  
  215. PROCEDURE IOError (no: INTEGER; t: BOOLEAN);
  216.   VAR msg: ARRAY [0..31] OF CHAR;
  217.   BEGIN
  218.     Files.GetStateMsg (no, msg);
  219.     InOutBase.IOError (msg, t)
  220.   END IOError;
  221.   
  222.  
  223. PROCEDURE Read (VAR c: CHAR);
  224.   (*$L-*)
  225.   BEGIN
  226.     ASSEMBLER
  227.         MOVE.L  -(A3),A0
  228.         MOVE.L  A0,-(A7)
  229.         MOVE.L  input,(A3)+
  230.         MOVE.L  A0,(A3)+
  231.         JSR     Text.Read
  232.         
  233.         MOVE.L  input,(A3)+
  234.         JSR     Text.EOL
  235.         TST     -(A3)
  236.         BEQ     e0
  237.         MOVE.L  input,(A3)+
  238.         JSR     Files.EOF
  239.         TST     -(A3)
  240.         BEQ     d2
  241.         
  242.         MOVE.L  input,(A3)+
  243.         JSR     Files.State
  244.         TST.W   -2(A3)
  245.         BPL     normalClose
  246.         MOVE    #1,(A3)+
  247.         JSR     IOError         ; IOError (State (input),TRUE)
  248.         CLR     done
  249.         JMP     CloseInput
  250.  
  251.      normalClose
  252.         SUBQ.L  #2,A3
  253.         JSR     CloseInput
  254.         CLR     done
  255.         MOVE.L  (A7)+,A0
  256.         CLR.B   (A0)            ; bei Dateiende ch:= 0C
  257.         RTS
  258.         
  259.      d2 MOVE.L  input,(A3)+
  260.         JSR     Text.ReadLn
  261.         MOVE.L  (A7),A0
  262.         MOVE.B  #EOL,(A0)
  263.      e0 ADDQ.L  #4,A7
  264.         MOVE    #1,done
  265.     END
  266.   END Read;
  267.   (*$L=*)
  268.  
  269.  
  270. PROCEDURE KeyPressed   (): BOOLEAN;
  271.   (*$L-*)
  272.   BEGIN
  273.     ASSEMBLER
  274.         MOVE    #1,(A3)+
  275.     END
  276.   END KeyPressed;
  277.   (*$L=*)
  278.  
  279. PROCEDURE CondRead     (VAR c: CHAR; VAR valid: BOOLEAN);
  280.   (*$L-*)
  281.   BEGIN
  282.     ASSEMBLER
  283.         MOVE.L  -(A3),-(A7)
  284.         MOVE.L  -(A3),D1
  285.         MOVE.L  D1,-(A7)
  286.         MOVE.L  input,A0
  287.         MOVE.W  FileDesc.uecho(A0),-(A7)
  288.         CLR.W   FileDesc.uecho(A0)       ; kein Echo
  289.         MOVE.L  A0,(A3)+
  290.         MOVE.L  D1,(A3)+
  291.         MOVE    #1,(A1)         ; valid:= TRUE
  292.         JSR     Text.Read
  293.         MOVE.L  input,A0
  294.         MOVE.W  (A7)+,FileDesc.uecho(A0)
  295.         
  296.         MOVE.L  A0,(A3)+
  297.         JSR     Text.EOL
  298.         TST     -(A3)
  299.         BEQ     e0
  300.         MOVE.L  input,(A3)+
  301.         JSR     Files.EOF
  302.         TST     -(A3)
  303.         BEQ     d2
  304.         
  305.         MOVE.L  (A7)+,A0
  306.         CLR.B   (A0)            ; ch:= 0C
  307.         MOVE.L  (A7)+,A0
  308.         CLR.W   (A0)            ; valid:= FALSE
  309.         CLR     done
  310.         
  311.         MOVE.L  input,(A3)+
  312.         JSR     Files.State
  313.         TST.W   -2(A3)
  314.         BPL     normalClose
  315.         
  316.         MOVE    #1,(A3)+
  317.         JSR     IOError         ; IOError (State (input),TRUE)
  318.         JMP     CloseInput
  319.  
  320.      normalClose
  321.         SUBQ.L  #2,A3
  322.         JMP     CloseInput
  323.         
  324.      d2 MOVE.L  input,(A3)+
  325.         JSR     Text.ReadLn
  326.         MOVE.L  (A7),A0
  327.         MOVE.B  #EOL,(A0)
  328.      e0 ADDQ.L  #4,A7
  329.         MOVE.L  (A7)+,A0
  330.         MOVE    #1,(A0)         ; valid
  331.         MOVE    #1,done
  332.     END
  333.   END CondRead;
  334.   (*$L=*)
  335.  
  336. PROCEDURE Skip;
  337.   (*$L-*)
  338.   BEGIN
  339.     ASSEMBLER
  340.         MOVE.L  input,(A3)+
  341.         JSR     Text.EOL
  342.         TST     -(A3)
  343.         BEQ     d1
  344.         MOVE.L  input,(A3)+
  345.         JSR     Files.EOF
  346.         TST     -(A3)
  347.         BEQ     d2
  348.         
  349.         CLR     done
  350.         MOVE.L  input,(A3)+
  351.         JSR     Files.State
  352.         TST.W   -2(A3)
  353.         BPL     normalClose
  354.         MOVE    #1,(A3)+
  355.         JSR     IOError         ; IOError (State (input),TRUE)
  356.      d3 JMP     CloseInput
  357.  
  358.      normalClose
  359.         SUBQ.L  #2,A3
  360.         BRA     d3
  361.         
  362.      d2 MOVE.B  #EOL,InOutBase.termCh
  363.         MOVE.L  input,(A3)+
  364.         JMP     Text.ReadLn
  365.      d1 MOVE.L  input,(A3)+
  366.         JSR     Text.UndoRead
  367.         MOVE.L  input,(A3)+
  368.         MOVE.L  #InOutBase.termCh,(A3)+
  369.         JMP     Text.Read
  370.     END
  371.   END Skip;
  372.   (*$L=*)
  373.  
  374. PROCEDURE ReadString (VAR s: ARRAY OF CHAR);
  375.   (*$L-*)
  376.   BEGIN
  377.     ASSEMBLER
  378.         MOVE.W  -(A3),D0
  379.         MOVE.L  -(A3),D1
  380.         MOVE.L  input,(A3)+
  381.         MOVE.L  D1,(A3)+
  382.         MOVE.W  D0,(A3)+
  383.         JSR     Text.ReadString
  384.         MOVE    #1,done
  385.         JMP     Skip
  386.     END
  387.   END ReadString;
  388.   (*$L=*)
  389.  
  390. PROCEDURE RdWLR;
  391.   (*$L-*)
  392.   BEGIN
  393.     ASSEMBLER
  394.         MOVE.L  -(A3),D0
  395.         MOVE.L  input,(A3)+
  396.         MOVE.L  D0,(A3)+
  397.         MOVE.L  #done,(A3)+
  398.         JSR     (A0)
  399.         JMP     Skip
  400.     END
  401.   END RdWLR;
  402.   (*$L=*)
  403.  
  404. PROCEDURE ReadCard     (VAR v: CARDINAL);
  405.   (*$L-*)
  406.   BEGIN
  407.     ASSEMBLER
  408.         JMP     NumberIO.ReadCard
  409.     END
  410.   END ReadCard;
  411.   (*$L=*)
  412.  
  413. PROCEDURE ReadInt      (VAR v: INTEGER);
  414.   (*$L-*)
  415.   BEGIN
  416.     ASSEMBLER
  417.         JMP     NumberIO.ReadInt
  418.     END
  419.   END ReadInt;
  420.   (*$L=*)
  421.  
  422. PROCEDURE ReadLCard    (VAR v: LONGCARD);
  423.   (*$L-*)
  424.   BEGIN
  425.     ASSEMBLER
  426.         JMP     NumberIO.ReadLCard
  427.     END
  428.   END ReadLCard;
  429.   (*$L=*)
  430.  
  431. PROCEDURE ReadLInt     (VAR v: LONGINT);
  432.   (*$L-*)
  433.   BEGIN
  434.     ASSEMBLER
  435.         JMP     NumberIO.ReadLInt
  436.     END
  437.   END ReadLInt;
  438.   (*$L=*)
  439.  
  440. PROCEDURE ReadReal     (VAR v: LONGREAL);
  441.   (*$L-*)
  442.   BEGIN
  443.     ASSEMBLER
  444.         JMP     NumberIO.ReadLReal
  445.     END
  446.   END ReadReal;
  447.   (*$L=*)
  448.  
  449. PROCEDURE ReadNum      (VAR v: WORD;     base: CARDINAL);
  450.   (*$L-*)
  451.   BEGIN
  452.     ASSEMBLER
  453.         MOVE.W  -(A3),D1
  454.         MOVE.L  -(A3),D0
  455.         MOVE.L  input,(A3)+
  456.         MOVE.L  D0,(A3)+
  457.         MOVE.W  D1,(A3)+
  458.         MOVE.L  #done,(A3)+
  459.         JSR     NumberIO.ReadNum
  460.         JMP     Skip
  461.     END
  462.   END ReadNum;
  463.   (*$L=*)
  464.  
  465. PROCEDURE ReadLNum     (VAR v: LONGWORD; base: CARDINAL);
  466.   (*$L-*)
  467.   BEGIN
  468.     ASSEMBLER
  469.         MOVE.W  -(A3),D1
  470.         MOVE.L  -(A3),D0
  471.         MOVE.L  input,(A3)+
  472.         MOVE.L  D0,(A3)+
  473.         MOVE.W  D1,(A3)+
  474.         MOVE.L  #done,(A3)+
  475.         JSR     NumberIO.ReadLNum
  476.         JMP     Skip
  477.     END
  478.   END ReadLNum;
  479.   (*$L=*)
  480.  
  481. (* ********************************************************************** *)
  482. (* ************************    A u s g a b e    ************************* *)
  483. (* ********************************************************************** *)
  484.  
  485.  
  486. PROCEDURE chkOut;
  487.   (*$L-*)
  488.   BEGIN
  489.     IF Files.State (output) < 0 THEN
  490.       IOError (Files.State (output),FALSE);
  491.       CloseOutput;
  492.     END;
  493.   END chkOut;
  494.   (*$L=*)
  495.  
  496.  
  497. PROCEDURE Write (c: CHAR);
  498.   (*$L-*)
  499.   BEGIN
  500.     ASSEMBLER
  501.         MOVE    -(A3),D0
  502.         MOVE.L  output,(A3)+
  503.         MOVE    D0,(A3)+
  504.         JSR     Text.Write
  505.         JMP     chkOut
  506.     END;
  507.   END Write;
  508.   (*$L=*)
  509.  
  510.  
  511. PROCEDURE WriteLn;
  512.   (*$L-*)
  513.   BEGIN
  514.     ASSEMBLER
  515.         MOVE.L  output,(A3)+
  516.         JSR     Text.WriteLn
  517.         JMP     chkOut
  518.     END
  519.   END WriteLn;
  520.   (*$L=*)
  521.  
  522. PROCEDURE WritePg;
  523.   (*$L-*)
  524.   BEGIN
  525.     ASSEMBLER
  526.         MOVE.L  output,(A3)+
  527.         JSR     Text.WritePg
  528.         JMP     chkOut
  529.     END
  530.   END WritePg;
  531.   (*$L=*)
  532.  
  533.  
  534. PROCEDURE GotoXY (x, y: CARDINAL);
  535.   (*$L-*)
  536.   BEGIN
  537.     ASSEMBLER
  538.         MOVE.L  -(A3),D0
  539.         LEA     goxy,A0
  540.         ADDI    #32,D0
  541.         MOVE.B  D0,3(A0)
  542.         SWAP    D0
  543.         ADDI    #32,D0
  544.         MOVE.B  D0,2(A0)
  545.         MOVE.L  output,(A3)+
  546.         MOVE.L  A0,(A3)+
  547.         MOVE    #3,(A0)+
  548.         JSR     Text.WriteString
  549.         JMP     chkOut
  550.     END
  551.   END GotoXY;
  552.   (*$L=*)
  553.  
  554.  
  555. PROCEDURE WriteString (REF s: ARRAY OF CHAR);
  556.   (*$L-*)
  557.   BEGIN
  558.     ASSEMBLER
  559.         MOVE.W  -(A3),D0
  560.         MOVE.L  -(A3),D1
  561.         MOVE.L  output,(A3)+
  562.         MOVE.L  D1,(A3)+
  563.         MOVE    D0,(A3)+
  564.         JSR     Text.WriteString
  565.         JMP     chkOut
  566.     END;
  567.   END WriteString;
  568.   (*$L=*)
  569.  
  570.  
  571. PROCEDURE initDriver;
  572.   (*$L-*)
  573.   BEGIN
  574.     ASSEMBLER
  575.         MOVE.L  #Read,InOutBase.fRead
  576.         MOVE.L  #KeyPressed,InOutBase.fKeyPressed
  577.         MOVE.L  #CondRead,InOutBase.fCondRead
  578.         MOVE.L  #ReadString,InOutBase.fReadString
  579.         MOVE.L  #RdWLR,InOutBase.fRdWLR
  580.         MOVE.L  #ReadCard,InOutBase.fReadCard
  581.         MOVE.L  #ReadInt,InOutBase.fReadInt
  582.         MOVE.L  #ReadLCard,InOutBase.fReadLCard
  583.         MOVE.L  #ReadLInt,InOutBase.fReadLInt
  584.         MOVE.L  #ReadNum,InOutBase.fReadNum
  585.         MOVE.L  #ReadLNum,InOutBase.fReadLNum
  586.         MOVE.L  #ReadReal,InOutBase.fReadReal
  587.         MOVE.L  #Write,InOutBase.fWrite
  588.         MOVE.L  #WriteLn,InOutBase.fWriteLn
  589.         MOVE.L  #WritePg,InOutBase.fWritePg
  590.         MOVE.L  #GotoXY,InOutBase.fGotoXY
  591.         MOVE.L  #WriteString,InOutBase.fWriteString
  592.         MOVE.L  #CloseInput,InOutBase.fCloseInput
  593.         MOVE.L  #CloseOutput,InOutBase.fCloseOutput
  594.     END
  595.   END initDriver;
  596.   (*$L=*)
  597.  
  598. BEGIN
  599.   ASSEMBLER
  600.         ; goxy[0]:=33C; (* ESC *)
  601.         ; goxy[1]:='Y';
  602.         MOVE    #$2759,goxy
  603.   END;
  604. END InOutFile.
  605. ə
  606. (* $00000D4D$00001F82$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$00002564$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFF68A69$FFFC497A$FFFC497A$FFFC497A$FFFC497A$FFFC497AÇ$0000011DT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000173$0000030E$0000003A$0000307B$000022C1$000025B5$000022B5$000031C3$000025B1$0000011E$FFEACF24$00000159$00001309$00000144$0000256C$00000033¿Çü*)
  607.